home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / scheme / boxer / boxer.lha / lodisp.lisp < prev    next >
Encoding:
Text File  |  1993-07-17  |  18.1 KB  |  450 lines
  1. ;; -*- Mode:LISP; Package:(BOXER GLOBAL 1000); Base: 8.; Fonts:cptfont -*-
  2.  
  3. #|
  4.             Copyright 1985 Massachusetts Institute of Technology
  5.  
  6.  Permission to use, copy, modify, distribute, and sell this software
  7.  and its documentation for any purpose is hereby granted without fee,
  8.  provided that the above copyright notice appear in all copies and that
  9.  both that copyright notice and this permission notice appear in
  10.  supporting documentation, and that the name of M.I.T. not be used in
  11.  advertising or publicity pertaining to distribution of the software
  12.  without specific, written prior permission.  M.I.T. makes no
  13.  representations about the suitability of this software for any
  14.  purpose.  It is provided "as is" without express or implied warranty.
  15.  
  16.  
  17.                                              +-Data--+
  18.                     This file is part of the | BOXER | system
  19.                                              +-------+
  20.  
  21.   This file contains the low level code for the connection/disconnection of
  22.   screen objects.  The file INFSUP has the analogous methods for editor objects
  23.  
  24. |#
  25.  
  26. ;;; LOW-LEVEL methods to handle connection and disconnection of screen-
  27. ;;; objs. These methods take care of all adding/removal of screen-chas
  28. ;;; to/from screen-rows, and all adding/removal of screen-rows to/from
  29. ;;; screen-boxes.
  30. ;;; Like all the other methods which are concerned with inferior/superior
  31. ;;; relations between screen-objs the connection/disconnection methods
  32. ;;; have specific names for the specific screen-objs involved, and also
  33. ;;; have abtract names which deal with the abstract superior/inferior
  34. ;;; relation between those screen-objs. The abstract names are aliases
  35. ;;; for the specific names.
  36.  
  37. ;;;   :INSERT-SCREEN-CHA <new-screen-cha> <before-screen-cha>
  38. ;;;   :INSERT-SCREEN-ROW <new-screen-row> <before-screen-row>
  39. ;;;   :INSERT-SCREEN-OBJ <new-screen-obj> <before-screen-obj>
  40. ;;; These methods all cause the screen-obj which receives the message
  41. ;;; to insert <new-screen-obj> in their screen inferiors just before
  42. ;;; <before-screen-obj>. For convenience, if <before-screen-obj> is
  43. ;;; null, <new-screen-obj> is appended to the existing inferiors.
  44. ;;; These methods also all have variants which take a list of screen-
  45. ;;; objs as their first argument, and insert the entire list before
  46. ;;; their second argument.
  47.  
  48. (DEFMETHOD (SCREEN-ROW :INSERT-SCREEN-CHA-AT-CHA-NO) (NEW-SCREEN-CHA CHA-NO)
  49.   (SPLICE-ITEM-INTO-LIST-AT SCREEN-CHAS NEW-SCREEN-CHA CHA-NO)
  50.   (WHEN (SCREEN-BOX? NEW-SCREEN-CHA)
  51.     (TELL NEW-SCREEN-CHA :SET-SCREEN-ROW SELF)))
  52.  
  53. (DEFMETHOD (SCREEN-ROW :INSERT-SCREEN-CHAS-AT-CHA-NO) (NEW-SCREEN-CHAS CHA-NO)
  54.   (SPLICE-LIST-INTO-LIST-AT SCREEN-CHAS NEW-SCREEN-CHAS CHA-NO)
  55.   (DOLIST (NEW-SCREEN-CHA NEW-SCREEN-CHAS)
  56.     (WHEN (SCREEN-BOX? NEW-SCREEN-CHA)
  57.       (TELL NEW-SCREEN-CHA :SET-SCREEN-ROW SELF))))
  58.  
  59. (DEFMETHOD (SCREEN-ROW :INSERT-SCREEN-CHA) (NEW-SCREEN-CHA BEFORE-SCREEN-CHA)
  60.   (CHECK-SCREEN-CHA-ARG NEW-SCREEN-CHA)
  61.   (COND ((NULL (TELL NEW-SCREEN-CHA :SCREEN-ROW))
  62.      (TELL NEW-SCREEN-CHA :SET-SCREEN-ROW SELF)
  63.      (IF (NOT-NULL BEFORE-SCREEN-CHA)
  64.          (SPLICE-ITEM-INTO-LIST SCREEN-CHAS NEW-SCREEN-CHA BEFORE-SCREEN-CHA)
  65.          (SPLICE-ITEM-ONTO-LIST SCREEN-CHAS NEW-SCREEN-CHA)))
  66.     (T
  67.      ;; Oops..
  68.      (BARF 'BOXER-REDISPLAY-ERROR ':FORMAT-CTL
  69.            "The screen-cha ~S is already part of ~S"
  70.            ':FORMAT-ARG
  71.            `(,NEW-SCREEN-CHA ,(TELL NEW-SCREEN-CHA :SCREEN-ROW))))))
  72.  
  73. (DEFMETHOD (SCREEN-ROW :INSERT-SCREEN-CHAS) (NEW-SCREEN-CHAS BEFORE-SCREEN-CHA)
  74.   (CHECK-SCREEN-CHA-ARG (CAR NEW-SCREEN-CHAS))
  75.   (COND ((NULL (TELL (CAR NEW-SCREEN-CHAS) :SCREEN-ROW))
  76.      (DOLIST (NEW-SCREEN-CHA NEW-SCREEN-CHAS)
  77.        (TELL NEW-SCREEN-CHA :SET-SCREEN-ROW SELF))
  78.      (IF (NOT-NULL BEFORE-SCREEN-CHA)
  79.          (SPLICE-LIST-INTO-LIST SCREEN-CHAS NEW-SCREEN-CHAS BEFORE-SCREEN-CHA)
  80.          (SPLICE-LIST-ONTO-LIST SCREEN-CHAS NEW-SCREEN-CHAS)))
  81.     (T
  82.      ;; Oops..
  83.      (BARF 'BOXER-REDISPLAY-ERROR
  84.            ':FORMAT-CTL
  85.            "I have only checked the first one, but the screen-chas ~S~%~
  86.                 seem to already be part of ~S"
  87.            ':FORMAT-ARG
  88.            `(,NEW-SCREEN-CHAS ,(TELL (CAR NEW-SCREEN-CHAS) :SCREEN-ROW))))))
  89.  
  90. (DEFMETHOD (SCREEN-BOX :INSERT-SCREEN-ROW) (NEW-SCREEN-ROW BEFORE-SCREEN-ROW)
  91.   (CHECK-SCREEN-ROW-ARG NEW-SCREEN-ROW)
  92.   (COND ((NULL (TELL NEW-SCREEN-ROW :SCREEN-BOX))
  93.      (TELL NEW-SCREEN-ROW :SET-SCREEN-BOX SELF)
  94.      (IF (NOT-NULL BEFORE-SCREEN-ROW)
  95.          (SPLICE-ITEM-INTO-LIST SCREEN-ROWS NEW-SCREEN-ROW BEFORE-SCREEN-ROW)
  96.          (SPLICE-ITEM-ONTO-LIST SCREEN-ROWS NEW-SCREEN-ROW)))
  97.     (T
  98.      (BARF 'BOXER-REDISPLAY-ERROR
  99.            ':FORMAT-CTL
  100.            "The screen-row ~S is already part of ~S"
  101.            ':FORMAT-ARG
  102.            `(,NEW-SCREEN-ROW ,(TELL NEW-SCREEN-ROW :SCREEN-ROW))))))
  103.  
  104. (DEFMETHOD (SCREEN-BOX :INSERT-SCREEN-ROWS) (NEW-SCREEN-ROWS BEFORE-SCREEN-ROW)
  105.   (CHECK-SCREEN-ROW-ARG (CAR NEW-SCREEN-ROWS))
  106.   (COND ((NULL (TELL (CAR NEW-SCREEN-ROWS) :SCREEN-BOX))
  107.      (DOLIST (NEW-SCREEN-ROW NEW-SCREEN-ROWS)
  108.        (TELL NEW-SCREEN-ROW :SET-SCREEN-BOX SELF))
  109.      (IF (NOT-NULL BEFORE-SCREEN-ROW)
  110.          (SPLICE-LIST-INTO-LIST SCREEN-ROWS NEW-SCREEN-ROWS BEFORE-SCREEN-ROW)
  111.          (SPLICE-LIST-ONTO-LIST SCREEN-ROWS NEW-SCREEN-ROWS)))
  112.     (T
  113.      (BARF 'BOXER-REDISPLAY-ERROR
  114.            ':FORMAT-CTL
  115.            "I have only checked the first one, but the screen-rows ~S~%~
  116.                 seem to already be part of ~S"
  117.            ':FORMAT-ARG
  118.            `(,NEW-SCREEN-ROWS ,(TELL (CAR NEW-SCREEN-ROWS) :SCREEN-ROW))))))
  119.  
  120. ;;; Alias for the abstract :INSERT-SCREEN-OBJs methods.
  121. (DEFMETHOD-ALIAS (SCREEN-ROW :INSERT-SCREEN-OBJ) :INSERT-SCREEN-CHA)
  122. (DEFMETHOD-ALIAS (SCREEN-BOX :INSERT-SCREEN-OBJ) :INSERT-SCREEN-ROW)
  123. (DEFMETHOD-ALIAS (SCREEN-ROW :INSERT-SCREEN-OBJS) :INSERT-SCREEN-CHAS)
  124. (DEFMETHOD-ALIAS (SCREEN-BOX :INSERT-SCREEN-OBJS) :INSERT-SCREEN-ROWS)
  125.  
  126.  
  127.  
  128. ;;;   :APPEND-SCREEN-CHA <new-screen-cha>
  129. ;;;   :APPEND-SCREEN-ROW <new-screen-row>
  130. ;;;   :APPEND-SCREEN-OBJ <new-screen-obj>
  131. ;;; These methods all cause the screen-obj which receives the message
  132. ;;; to append <new-screen-obj> to their existing screen inferiors.
  133. ;;; Note that this is just like :insert-screen-obj with a null second
  134. ;;; argument. Just like :insert-screen-obj methods, :append-screen-obj
  135. ;;; methods have variants that take a list of new-screen-objs and append
  136. ;;; the entire list to the existing screen inferiors.
  137.  
  138. (DEFMETHOD (SCREEN-ROW :APPEND-SCREEN-CHA) (NEW-SCREEN-CHA)
  139.   (SPLICE-ITEM-ONTO-LIST SCREEN-CHAS NEW-SCREEN-CHA)
  140.   (WHEN (SCREEN-BOX? NEW-SCREEN-CHA)
  141.     (TELL NEW-SCREEN-CHA :SET-SCREEN-ROW SELF)))
  142.  
  143. (DEFMETHOD (SCREEN-ROW :APPEND-SCREEN-CHAS) (NEW-SCREEN-CHAS)
  144.   (SPLICE-LIST-ONTO-LIST SCREEN-CHAS NEW-SCREEN-CHAS)
  145.   (DOLIST (NEW-SCREEN-CHA NEW-SCREEN-CHAS)
  146.     (WHEN (SCREEN-BOX? NEW-SCREEN-CHA)
  147.       (TELL NEW-SCREEN-CHA :SET-SCREEN-ROW SELF))))
  148.  
  149. (DEFMETHOD (SCREEN-BOX :APPEND-SCREEN-ROW) (NEW-SCREEN-ROW)
  150.   (CHECK-SCREEN-ROW-ARG NEW-SCREEN-ROW)
  151.   (COND ((NULL (TELL NEW-SCREEN-ROW :SCREEN-BOX))
  152.      (TELL NEW-SCREEN-ROW :SET-SCREEN-BOX SELF)
  153.      (SPLICE-ITEM-ONTO-LIST SCREEN-ROWS NEW-SCREEN-ROW))
  154.     (T
  155.      ;; Oops..
  156.      (BARF 'BOXER-REDISPLAY-ERROR
  157.            ':FORMAT-CTL
  158.            "The screen row ~s is already part of ~S"
  159.            ':FORMAT-ARG
  160.            `(,NEW-SCREEN-ROW ,(TELL NEW-SCREEN-ROW :SCREEN-BOX))))))
  161.  
  162. (DEFMETHOD (SCREEN-BOX :APPEND-SCREEN-ROWS) (NEW-SCREEN-ROWS)
  163.   (CHECK-SCREEN-ROW-ARG (CAR NEW-SCREEN-ROWS))
  164.   (COND ((NULL (TELL (CAR NEW-SCREEN-ROWS) :SCREEN-BOX))
  165.      (DOLIST (NEW-SCREEN-ROW NEW-SCREEN-ROWS)
  166.        (TELL NEW-SCREEN-ROW :SET-SCREEN-BOX SELF))
  167.      (SPLICE-LIST-ONTO-LIST SCREEN-ROWS NEW-SCREEN-ROWS))
  168.     (T
  169.      ;; Oops
  170.      (BARF 'BOXER-REDISPLAY-ERROR
  171.            ':FORMAT-CTL
  172.            "I have only checked the first one, but the screen-rows ~S~%~
  173.                 seem to already be part of ~S"
  174.            ':FORMAT-ARG
  175.            `(,NEW-SCREEN-ROWS ,(TELL (CAR NEW-SCREEN-ROWS) :SCREEN-BOX))))))
  176.  
  177. ;;; Alias for the abstract :APPEND-SCREEN-OBJs methods.
  178. (DEFMETHOD-ALIAS (SCREEN-ROW :APPEND-SCREEN-OBJ) :APPEND-SCREEN-CHA)
  179. (DEFMETHOD-ALIAS (SCREEN-BOX :APPEND-SCREEN-OBJ) :APPEND-SCREEN-ROW)
  180. (DEFMETHOD-ALIAS (SCREEN-ROW :APPEND-SCREEN-OBJS) :APPEND-SCREEN-CHAS)
  181. (DEFMETHOD-ALIAS (SCREEN-BOX :APPEND-SCREEN-OBJS) :APPEND-SCREEN-ROWS)
  182.  
  183.  
  184.  
  185.  
  186. ;;;   :DELETE-SCREEN-CHA <screen-cha>
  187. ;;;   :DELETE-SCREEN-ROW <screen-row>
  188. ;;;   :DELETE-SCREEN-OBJ <screen-obj>
  189. ;;; These methods all cause the screen-obj which receives the message
  190. ;;; to delete <screen-obj> from their screen inferiors. To help with
  191. ;;; deleting multiple inferior screen objs, these methods have variants
  192. ;;; (called :delete-between-screen-objs <from-screen-obj> <to-screen-obj>
  193. ;;; which delete all the inferior screen-objs between <from-screen-obj>
  194. ;;; (inclusive) and <to-screen-obj> (exclusive).
  195.  
  196. (DEFMETHOD (SCREEN-ROW :DELETE-SCREEN-CHA-AT-CHA-NO) (CHA-NO)
  197.   (LET ((CHA-TO-DELETE (NTH CHA-NO SCREEN-CHAS)))
  198.     (SPLICE-ITEM-OUT-OF-LIST-AT SCREEN-CHAS CHA-NO)
  199.     (WHEN (SCREEN-BOX? CHA-TO-DELETE)
  200.       (TELL CHA-TO-DELETE :SET-SCREEN-ROW NIL))))
  201.  
  202. (DEFMETHOD (SCREEN-ROW :DELETE-SCREEN-CHAS-FROM-TO) (FROM-CHA-NO TO-CHA-NO)
  203.   (LET ((CHAS-TO-DELETE (ITEMS-SPLICED-FROM-TO-FROM-LIST SCREEN-CHAS FROM-CHA-NO TO-CHA-NO)))
  204.     (SPLICE-ITEMS-FROM-TO-OUT-OF-LIST SCREEN-CHAS FROM-CHA-NO TO-CHA-NO)
  205.     (DOLIST (CHA-TO-DELETE CHAS-TO-DELETE)
  206.       (WHEN (SCREEN-BOX? CHA-TO-DELETE)
  207.     (TELL CHA-TO-DELETE :SET-SCREEN-ROW NIL)))))
  208.  
  209. (DEFMETHOD (SCREEN-ROW :DELETE-SCREEN-CHA) (SCREEN-CHA-TO-DELETE)
  210.   (CHECK-SCREEN-CHA-ARG SCREEN-CHA-TO-DELETE)
  211.   (COND ((EQ (TELL SCREEN-CHA-TO-DELETE :SCREEN-ROW) SELF)
  212.      (TELL SCREEN-CHA-TO-DELETE :SET-SCREEN-ROW NIL)
  213.      (SPLICE-ITEM-OUT-OF-LIST SCREEN-CHAS SCREEN-CHA-TO-DELETE))
  214.     (T
  215.      ;; Oops..
  216.      (BARF 'BOXER-REDISPLAY-ERROR
  217.            "The screen-cha ~S is not part of the screen-row ~S"
  218.            SCREEN-CHA-TO-DELETE SELF))))
  219.  
  220. (DEFMETHOD (SCREEN-ROW :DELETE-BETWEEN-SCREEN-CHAS) (FROM-SCREEN-CHA TO-SCREEN-CHA)
  221.   (CHECK-SCREEN-CHA-ARG FROM-SCREEN-CHA)
  222.   (CHECK-SCREEN-CHA-ARG TO-SCREEN-CHA)
  223.   (COND ((AND (EQ (TELL FROM-SCREEN-CHA :SCREEN-ROW) SELF)
  224.           (EQ (TELL TO-SCREEN-CHA :SCREEN-ROW) SELF))
  225.      (LET ((DELETED-SCREEN-CHAS (TELL FROM-SCREEN-CHA :SELF-AND-NEXT-SCREEN-CHAS)))
  226.        (SPLICE-BETWEEN-ITEMS-OUT-OF-LIST SCREEN-CHAS FROM-SCREEN-CHA TO-SCREEN-CHA)
  227.        (DOLIST (DELETED-SCREEN-CHA DELETED-SCREEN-CHAS)
  228.          (TELL DELETED-SCREEN-CHA :SET-SCREEN-ROW NIL))))
  229.     (T
  230.      ;; Oops..
  231.      (BARF 'BOXER-REDISPLAY-ERROR
  232.            ':FORMAT-CTL
  233.            "The screen-chas ~S and ~S are not both part of the screen row ~S"
  234.            ':FORMAT-ARG
  235.           `(FROM-SCREEN-CHA ,TO-SCREEN-CHA ,SELF)))))
  236.  
  237. (DEFMETHOD (SCREEN-BOX :DELETE-SCREEN-ROW) (SCREEN-ROW-TO-DELETE)
  238.   (CHECK-SCREEN-ROW-ARG SCREEN-ROW-TO-DELETE)
  239.   (COND ((EQ (TELL SCREEN-ROW-TO-DELETE :SCREEN-BOX) SELF)
  240.      (TELL SCREEN-ROW-TO-DELETE :SET-SCREEN-BOX NIL)
  241.      (SPLICE-ITEM-OUT-OF-LIST SCREEN-ROWS SCREEN-ROW-TO-DELETE))
  242.     (T
  243.      ;; Oops..
  244.      (BARF 'BOXER-REDISPLAY-ERROR
  245.            ':FORMAT-CTL
  246.            "The screen-row ~S is not part of the screen-box ~S"
  247.            ':FORMAT-ARG
  248.            `(,SCREEN-ROW-TO-DELETE ,SELF)))))
  249.  
  250. (DEFMETHOD (SCREEN-BOX :DELETE-BETWEEN-SCREEN-ROWS) (FROM-SCREEN-ROW TO-SCREEN-ROW)
  251.   (CHECK-SCREEN-ROW-ARG FROM-SCREEN-ROW)
  252.   (CHECK-SCREEN-ROW-ARG TO-SCREEN-ROW)
  253.   (COND ((AND (EQ (TELL FROM-SCREEN-ROW :SCREEN-BOX) SELF)
  254.           (EQ (TELL TO-SCREEN-ROW :SCREEN-BOX) SELF))
  255.      (LET ((DELETED-SCREEN-ROWS (TELL FROM-SCREEN-ROW :SELF-AND-NEXT-SCREEN-ROWS)))
  256.        (SPLICE-BETWEEN-ITEMS-OUT-OF-LIST SCREEN-ROWS FROM-SCREEN-ROW TO-SCREEN-ROW)
  257.        (DOLIST (DELETED-SCREEN-ROW DELETED-SCREEN-ROWS)
  258.          (TELL DELETED-SCREEN-ROW :SET-SCREEN-BOX NIL))))
  259.     (T
  260.      ;; Oops..
  261.      (BARF 'BOXER-REDISPLAY-ERROR
  262.            "The screen-rows ~S and ~S are not both part of the screen box ~S"
  263.           FROM-SCREEN-ROW TO-SCREEN-ROW SELF))))
  264.  
  265. ;;; Alias for the abstract :DELETE-SCREEN-OBJ methods.
  266. (DEFMETHOD-ALIAS (SCREEN-ROW :DELETE-SCREEN-OBJ) :DELETE-SCREEN-CHA)
  267. (DEFMETHOD-ALIAS (SCREEN-BOX :DELETE-SCREEN-OBJ) :DELETE-SCREEN-ROW)
  268. (DEFMETHOD-ALIAS (SCREEN-ROW :DELETE-BETWEEN-SCREEN-OBJS) :DELETE-BETWEEN-SCREEN-CHAS)
  269. (DEFMETHOD-ALIAS (SCREEN-BOX :DELETE-BETWEEN-SCREEN-OBJS) :DELETE-BETWEEN-SCREEN-ROWS)
  270.  
  271.  
  272.  
  273. ;;;   :KILL-SCREEN-CHA <screen-cha>
  274. ;;;   :KILL-SCREEN-ROW <screen-row>
  275. ;;;   :KILL-SCREEN-OBJ <screen-obj>
  276. ;;; These methods all cause the screen-obj which receives the message
  277. ;;; to delete <screen-obj> and all the inferior screen-objs which
  278. ;;; follow <screen-obj> from their screen inferiors.
  279.  
  280. (DEFMETHOD (SCREEN-ROW :KILL-SCREEN-CHAS-FROM) (NO-OF-FIRST-OBJ-TO-KILL)
  281.   (LET ((KILLED-SCREEN-CHAS (NTHCDR NO-OF-FIRST-OBJ-TO-KILL SCREEN-CHAS)))
  282.     (SPLICE-ITEM-AND-TAIL-OUT-OF-LIST-FROM SCREEN-CHAS NO-OF-FIRST-OBJ-TO-KILL)
  283.     (DOLIST (KILLED-SCREEN-CHA KILLED-SCREEN-CHAS)
  284.       (WHEN (SCREEN-BOX? KILLED-SCREEN-CHA)
  285.     (TELL KILLED-SCREEN-CHA :SET-SCREEN-ROW NIL)))))
  286.  
  287. (DEFMETHOD (SCREEN-ROW :KILL-SCREEN-CHA) (SCREEN-CHA-TO-KILL)
  288.   (CHECK-SCREEN-CHA-ARG SCREEN-CHA-TO-KILL)
  289.   (COND ((EQ (TELL SCREEN-CHA-TO-KILL :SCREEN-ROW) SELF)
  290.      (LET ((KILLED-SCREEN-CHAS (MEMQ SCREEN-CHA-TO-KILL SCREEN-CHAS)))
  291.        (DOLIST (KILLED-SCREEN-CHA KILLED-SCREEN-CHAS)
  292.          (WHEN (SCREEN-BOX? KILLED-SCREEN-CHA)
  293.            (TELL KILLED-SCREEN-CHA :SET-SCREEN-ROW NIL)))
  294.        (SPLICE-ITEM-AND-TAIL-OUT-OF-LIST SCREEN-CHAS SCREEN-CHA-TO-KILL)))
  295.     (T
  296.      ;; Oops..
  297.      (BARF 'BOXER-REDISPLAY-ERROR
  298.            ':FORMAT-CTL
  299.            "The screen cha ~S is not part of the screen row ~S"
  300.            ':FORMAT-ARG
  301.            `(,SCREEN-CHA-TO-KILL ,SELF)))))
  302.  
  303. (DEFMETHOD (SCREEN-BOX :KILL-SCREEN-ROW) (SCREEN-ROW-TO-KILL)
  304.   (CHECK-SCREEN-ROW-ARG SCREEN-ROW-TO-KILL)
  305.   (COND ((EQ (TELL SCREEN-ROW-TO-KILL :SCREEN-BOX) SELF)
  306.      (LET ((KILLED-SCREEN-ROWS (MEMQ SCREEN-ROW-TO-KILL SCREEN-ROWS)))
  307.        (DOLIST (KILLED-SCREEN-ROW KILLED-SCREEN-ROWS)
  308.          (TELL KILLED-SCREEN-ROW :SET-SCREEN-BOX NIL))
  309.        (SPLICE-ITEM-AND-TAIL-OUT-OF-LIST SCREEN-ROWS SCREEN-ROW-TO-KILL)))
  310.     (T
  311.      ;; Oops..
  312.      (BARF 'BOXER-REDISPLAY-ERROR
  313.            ':FORMAT-CTL
  314.            "The screen row ~S is not part of the screen box ~S"
  315.            ':FORMAT-ARG
  316.            `(,SCREEN-ROW-TO-KILL ,SELF)))))
  317.  
  318. ;;; Alis for the abstract :KILL-SCREEN-OBJ methods.
  319. (DEFMETHOD-ALIAS (SCREEN-ROW :KILL-SCREEN-OBJ) :KILL-SCREEN-CHA)
  320. (DEFMETHOD-ALIAS (SCREEN-BOX :KILL-SCREEN-OBJ) :KILL-SCREEN-ROW)
  321.  
  322.  
  323.  
  324.  
  325. ;;; LOW-LEVEL screen-obj accessors. All of these do the obvious thing.
  326. (DEFMETHOD (SCREEN-ROW :SCREEN-OBJS-AT-AND-AFTER) (NO-OF-FIRST-OBJ)
  327.   (NTHCDR NO-OF-FIRST-OBJ SCREEN-CHAS))
  328.  
  329. (DEFMETHOD (SCREEN-ROW :SCREEN-CHA-AT-CHA-NO) (CHA-NO)
  330.   (NTH CHA-NO SCREEN-CHAS))
  331.  
  332. (DEFMETHOD (SCREEN-ROW :SCREEN-OBJS-AFTER) (NO-OF-FIRST-OBJ)
  333.   (NTHCDR (+ 1 NO-OF-FIRST-OBJ) SCREEN-CHAS))
  334.  
  335. (DEFMETHOD (SCREEN-ROW :FIRST-SCREEN-CHA) ()
  336.   (FIRST SCREEN-CHAS))
  337.  
  338. (DEFMETHOD (SCREEN-BOX :FIRST-SCREEN-ROW) ()
  339.   (FIRST SCREEN-ROWS))
  340.  
  341. ;;; Graphics-screen-box accessors
  342. ;;; since graphics boxes have NO rows we use the SCREEN-ROWS instance variable which should be
  343. ;;; renamed immediate inferiors or some such to reflect the fact that it can contain SHEETS
  344. (DEFMETHOD (GRAPHICS-SCREEN-BOX :SCREEN-SHEET) ()
  345.   SCREEN-ROWS)
  346.  
  347. (DEFMETHOD (GRAPHICS-SCREEN-BOX :SET-SCREEN-SHEET) (NEW-SHEET)
  348.   (SETQ SCREEN-ROWS NEW-SHEET)
  349.   (SETF (GRAPHICS-SCREEN-SHEET-SCREEN-BOX NEW-SHEET) SELF))
  350.  
  351. ;;;obselete no one should be calling these;;;;;;;;;;;;;;;;
  352. (DEFMETHOD (SCREEN-CHA :NEXT-SCREEN-CHA) ()
  353.   (CADR (TELL SELF :SELF-AND-NEXT-SCREEN-CHAS)))
  354.  
  355. (DEFMETHOD (SCREEN-CHA :NEXT-SCREEN-CHAS) ()
  356.   (CDR (TELL SELF :SELF-AND-NEXT-SCREEN-CHAS)))
  357.  
  358. (DEFMETHOD (SCREEN-CHA :SELF-AND-NEXT-SCREEN-CHAS) ()
  359.   (MEMQ SELF (TELL SCREEN-ROW :SCREEN-CHAS)))
  360. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  361.  
  362. (DEFMETHOD (SCREEN-ROW :NEXT-SCREEN-ROW) ()
  363.   (CADR (TELL SELF :SELF-AND-NEXT-SCREEN-ROWS)))
  364.  
  365. (DEFMETHOD (SCREEN-ROW :NEXT-SCREEN-ROWS) ()
  366.   (CDR (TELL SELF :SELF-AND-NEXT-SCREEN-ROWS)))
  367.  
  368. (DEFMETHOD (SCREEN-ROW :SELF-AND-NEXT-SCREEN-ROWS) ()
  369.   (MEMQ SELF (TELL SCREEN-BOX :SCREEN-ROWS)))
  370.  
  371. (DEFMETHOD (SCREEN-CHA :INFERIORS) () NIL)
  372. (DEFMETHOD-ALIAS (SCREEN-ROW :INFERIORS) :SCREEN-CHAS)
  373. (DEFMETHOD-ALIAS (SCREEN-BOX :INFERIORS) :SCREEN-ROWS)
  374.  
  375. (DEFMETHOD-ALIAS (SCREEN-CHA :SUPERIOR) :SCREEN-ROW)
  376. (DEFMETHOD-ALIAS (SCREEN-ROW :SUPERIOR) :SCREEN-BOX)
  377.  
  378. (DEFMETHOD-ALIAS (SCREEN-ROW :FIRST-SCREEN-OBJ) :FIRST-SCREEN-CHA)
  379. (DEFMETHOD-ALIAS (SCREEN-BOX :FIRST-SCREEN-OBJ) :FIRST-SCREEN-ROW)
  380.  
  381. (DEFMETHOD-ALIAS (SCREEN-CHA :NEXT-SCREEN-OBJ) :NEXT-SCREEN-CHA)
  382. (DEFMETHOD-ALIAS (SCREEN-ROW :NEXT-SCREEN-OBJ) :NEXT-SCREEN-ROW)
  383. (DEFMETHOD-ALIAS (SCREEN-CHA :NEXT-SCREEN-OBJS) :NEXT-SCREEN-CHAS)
  384. (DEFMETHOD-ALIAS (SCREEN-ROW :NEXT-SCREEN-OBJS) :NEXT-SCREEN-ROWS)
  385. (DEFMETHOD-ALIAS (SCREEN-CHA :SELF-AND-NEXT-SCREEN-OBJS) :SELF-AND-NEXT-SCREEN-CHAS)
  386. (DEFMETHOD-ALIAS (SCREEN-ROW :SELF-AND-NEXT-SCREEN-OBJS) :SELF-AND-NEXT-SCREEN-ROWS)
  387.  
  388.  
  389. (DEFMETHOD (SCREEN-CHA :SCREEN-BOX) ()
  390.   (IF (SCREEN-ROW? SCREEN-ROW)
  391.       (TELL SCREEN-ROW :SCREEN-BOX)
  392.       SCREEN-ROW))
  393.  
  394. (DEFMETHOD (SCREEN-ROW :SCREEN-BOX) ()
  395.   SCREEN-BOX)
  396.  
  397. (DEFMETHOD (SCREEN-BOX :SCREEN-BOX) ()
  398.   SUPERIOR-SCREEN-BOX)
  399.  
  400. (DEFMETHOD (SCREEN-BOX :SUPERIOR-SCREEN-BOX) ()
  401.   (TELL SELF :SCREEN-BOX))
  402.  
  403. (DEFMETHOD (SCREEN-CHA :LOWEST-SCREEN-BOX) ()
  404.   (TELL SCREEN-ROW :LOWEST-SCREEN-BOX))
  405.  
  406. (DEFMETHOD (SCREEN-ROW :LOWEST-SCREEN-BOX) ()
  407.   SCREEN-BOX)
  408.  
  409. (DEFMETHOD (SCREEN-BOX :LOWEST-SCREEN-BOX) ()
  410.   SELF)
  411.  
  412. (DEFMETHOD (SCREEN-OBJ :OFFSETS) ()
  413.   (VALUES X-OFFSET Y-OFFSET))
  414.  
  415. (DEFMETHOD (SCREEN-OBJ :SET-OFFSETS) (NEW-X-OFFSET NEW-Y-OFFSET)
  416.   (SETQ X-OFFSET NEW-X-OFFSET
  417.     Y-OFFSET NEW-Y-OFFSET))
  418.  
  419. ;;; Changing from/to SCREEN-BOXES and GRAPHICS-SCREEN-BOXES
  420.  
  421. (DEFMETHOD (SCREEN-BOX :BEFORE :SET-FLAVOR) (IGNORE)
  422.   (DOLIST (SCR-ROW SCREEN-ROWS)
  423.     (TELL SCR-ROW :SET-SCREEN-BOX NIL)
  424.     (TELL SCR-ROW :DEALLOCATE-SELF)
  425.     (SETQ SCREEN-ROWS NIL)))
  426.  
  427. (DEFMETHOD (GRAPHICS-SCREEN-BOX :BEFORE :SET-FLAVOR) (IGNORE)
  428.   (LET ((GRAPHICS-SHEET (AND SCREEN-ROWS (GRAPHICS-SCREEN-SHEET-ACTUAL-OBJ SCREEN-ROWS))))
  429.     (UNLESS (NULL GRAPHICS-SHEET)
  430.       (SETF (GRAPHICS-SHEET-SCREEN-OBJS GRAPHICS-SHEET)
  431.         (DELQ (ASSQ SELF (GRAPHICS-SHEET-SCREEN-OBJS GRAPHICS-SHEET))
  432.           (GRAPHICS-SHEET-SCREEN-OBJS GRAPHICS-SHEET))))
  433.     (SETQ SCREEN-ROWS NIL)))
  434.  
  435. ;;; Methods that support the interaction between BP's and SCREEN BOXEs
  436.  
  437. (DEFMETHOD (SCREEN-BOX :SET-BPS) (NEW-VALUE)
  438.   (CHECK-ARG NEW-VALUE #+ti '(LAMBDA (X) (AND (LISTP X) (EVERY X 'BP?)))
  439.                    #-ti #'(LAMBDA (X) (AND (LISTP X) (EVERY X 'BP?)))
  440.     "A list of Boxer BP's")
  441.   (SETQ BPS NEW-VALUE))
  442.  
  443. (DEFMETHOD (SCREEN-BOX :ADD-BP) (NEW-BP)
  444.   (CHECK-BP-ARG NEW-BP)
  445.   (PUSH NEW-BP BPS))
  446.  
  447. (DEFMETHOD (SCREEN-BOX :DELETE-BP) (BP)
  448.   (CHECK-BP-ARG BP)
  449.   (SETQ BPS (DELETE BP BPS)))
  450.